home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / paint.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-03-24  |  8.9 KB  |  278 lines
  1. Syntax10.Scn.Fnt
  2. FoldElems
  3. Syntax10b.Scn.Fnt
  4. MODULE Paint;
  5. IMPORT Oberon, Texts, PictureFrames, Pictures, TextFrames, MenuViewers, Display, Viewers, Printer, Files, TextPrinter;
  6. VAR W : Texts.Writer;
  7. PROCEDURE OpenScanner(VAR S: Texts.Scanner);
  8.     VAR s : Texts.Scanner;    text : Texts.Text;    beg,end,time : LONGINT;
  9. BEGIN
  10.     Texts.OpenScanner(S,Oberon.Par.text,Oberon.Par.pos);
  11.     s := S; Texts.Scan(s);
  12.     IF (s.class = Texts.Char) & (s.c = "^") THEN
  13.         Oberon.GetSelection(text,beg,end,time);
  14.         IF time > 0 THEN Texts.OpenScanner(S,text,beg) END
  15. END OpenScanner;
  16. (* get selected frame *)
  17. PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
  18.     VAR v: Viewers.Viewer;
  19. BEGIN
  20.     IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
  21.         IF (Oberon.Par.frame # NIL) THEN
  22.             f:=Oberon.Par.frame.next;
  23.             RETURN TRUE
  24.         END
  25.     ELSE
  26.         v:=Oberon.MarkedViewer();
  27.         IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
  28.             f:=v.dsc.next;
  29.             RETURN TRUE
  30.         END
  31.     END;
  32.     RETURN FALSE
  33. END GetFrame;
  34. PROCEDURE Resize*;
  35.     VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT; F : PictureFrames.Frame;
  36. BEGIN
  37.     IF  Oberon.Par.vwr.dsc.next IS PictureFrames.Frame THEN
  38.         F := Oberon.Par.vwr.dsc.next(PictureFrames.Frame);
  39.         PictureFrames.GetSelection(P,time,x,y,w,h);
  40.         IF  F.time = time THEN
  41.             PictureFrames.Resize(F, x,y,w,h)
  42.         END
  43. END Resize;
  44. PROCEDURE Zoom*;
  45.     VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT; F : PictureFrames.Frame;
  46. BEGIN
  47.     IF  Oberon.Par.vwr.dsc.next IS PictureFrames.Frame THEN
  48.         PictureFrames.GetSelection(P,time,x,y,w,h);
  49.         F := Oberon.Par.vwr.dsc.next(PictureFrames.Frame);
  50.         PictureFrames.Neutralize(F);
  51.         IF time > 0 THEN F.l := x; F.t := y + h END;
  52.         IF F.zoom = 8 THEN F.zoom := 1 ELSE F.zoom := 8 END; PictureFrames.Restore(F)
  53. END Zoom;
  54. PROCEDURE StoreColors*;
  55.     VAR P : Pictures.Picture; i, r ,g ,b : INTEGER;
  56.         f, e: Display.Frame;
  57. BEGIN
  58.     IF GetFrame(e) THEN
  59.         f:=e;
  60.         WITH f: PictureFrames.Frame DO
  61.             P := f.pict;
  62.             IF P.depth # 1 THEN i := 0;
  63.                 WHILE i < ASH(1,P.depth) DO
  64.                     Display.GetColor(i,r,g,b);  Pictures.SetColor(P,i,r,g,b);
  65.                     INC(i)
  66.                 END
  67.             END
  68.         ELSE
  69.         END
  70. END StoreColors;
  71. PROCEDURE LoadColors*;
  72.     VAR P : Pictures.Picture; i,r,g,b : INTEGER;
  73.         f, e: Display.Frame;
  74. BEGIN
  75.     IF GetFrame(e) THEN
  76.         f:=e;
  77.         WITH f: PictureFrames.Frame DO
  78.             P := f.pict;
  79.             IF P.depth # 1 THEN i := 0;
  80.                 WHILE i < ASH(1,P.depth) DO
  81.                     Pictures.GetColor(P,i,r,g,b);
  82.                     Display.SetColor(i,r,g,b);
  83.                     INC(i)
  84.                 END
  85.             END
  86.         ELSE
  87.         END
  88. END LoadColors;
  89. PROCEDURE ChangeColor*;
  90.     VAR P : Pictures.Picture; S : Texts.Scanner; c1,c2,x,y : INTEGER;
  91.         f, e: Display.Frame;
  92. BEGIN
  93.     IF GetFrame(e) THEN
  94.         f:=e;
  95.         WITH f: PictureFrames.Frame DO
  96.             P := f.pict;
  97.             IF P.depth # 1 THEN
  98.                 OpenScanner(S); Texts.Scan(S);
  99.                 IF S.class = Texts.Int THEN c1 := SHORT(S.i);
  100.                     Texts.Scan(S);
  101.                     IF S.class = Texts.Int THEN c2 := SHORT(S.i);
  102.                         y :=  0;
  103.                         WHILE y < P.height DO x := 0;
  104.                             WHILE x < P.width DO
  105.                                 IF Pictures.Get(P,x,y) = c1 THEN Pictures.Dot(P,c2,x,y,Display.replace) END;
  106.                                 INC(x)
  107.                             END;
  108.                             INC(y)
  109.                         END;
  110.                         Pictures.Update(P,0,0,P.width,P.height)
  111.                     END
  112.                 END
  113.             END
  114.         ELSE
  115.         END
  116. END ChangeColor;
  117. PROCEDURE Invert*;
  118.     VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT;
  119. BEGIN
  120.     PictureFrames.GetSelection(P,time,x,y,w,h);
  121.     IF  time > 0 THEN
  122.         Pictures.ReplConst(P,Display.white,x,y,w,h,Display.invert);
  123.         Pictures.Update(P,x,y,w,h)
  124. END Invert;
  125. PROCEDURE Fill*;
  126.     VAR P : Pictures.Picture; x, y, w, h : INTEGER; time : LONGINT; S : Texts.Scanner;
  127. BEGIN
  128.     PictureFrames.GetSelection(P,time,x,y,w,h);
  129.     IF  time > 0 THEN
  130.         OpenScanner(S); Texts.Scan(S);
  131.         IF S.class = Texts.Int THEN
  132.             Pictures.ReplConst(P,SHORT(S.i),x,y,w,h,Display.replace);
  133.             Pictures.Update(P,x,y,w,h)
  134.         END
  135. END Fill;
  136. PROCEDURE PrintInfo(P: Pictures.Picture);
  137. BEGIN
  138.     Texts.WriteString(W, "Width=");Texts.WriteInt(W,P.width, 1);
  139.     Texts.WriteString(W, "  Height=");Texts.WriteInt(W,P.height, 1);
  140.     Texts.WriteString(W, "  Depth=");Texts.WriteInt(W,P.depth, 1);
  141.     Texts.WriteLn(W);Texts.Append(Oberon.Log, W.buf)
  142. END PrintInfo;
  143. PROCEDURE Info*;
  144.     VAR V : Viewers.Viewer; P : Pictures.Picture;
  145. BEGIN
  146.     V := Oberon.MarkedViewer();
  147.     IF V.dsc.next IS PictureFrames.Frame THEN
  148.         P := V.dsc.next (PictureFrames.Frame).pict;
  149.         PrintInfo(P)
  150. END Info;
  151. PROCEDURE Open*;
  152.     VAR S : Texts.Scanner; V : Viewers.Viewer;  X, Y :  INTEGER; P : Pictures.Picture; F : PictureFrames.Frame;
  153. BEGIN
  154.     OpenScanner(S); Texts.Scan(S);
  155.     IF S.class # Texts.Name THEN S.s := "Empty.Pict" END;
  156.     NEW(F); P := PictureFrames.Picture(S.s);
  157.     F := PictureFrames.NewPicture(P);
  158.     Texts.WriteString(W, S.s);Texts.WriteString(W, ": ");PrintInfo(P);
  159.     Oberon.AllocateUserViewer(Oberon.Par.vwr.X,X,Y);
  160.     V := MenuViewers.New(TextFrames.NewMenu(S.s, "^Paint.Menu.Text"),F, TextFrames.menuH, X, Y)
  161. END Open;
  162. PROCEDURE TestColorSet(P: Pictures.Picture);
  163.         i, k, r, g, b: INTEGER;
  164.         status: BOOLEAN;
  165. BEGIN
  166.     status:=FALSE;k:=SHORT(ASH(1, P.depth));i:=0;
  167.     REPEAT
  168.         Pictures.GetColor(P, i, r, g, b);
  169.         status:=status OR (r#0) OR (g#0) OR (b#0);
  170.         INC(i)
  171.     UNTIL status OR (i=k);
  172.     IF ~status THEN
  173.         FOR i:=0 TO ASH(1, P.depth)-1 DO
  174.             Display.GetColor(i,r,g,b);
  175.             Pictures.SetColor(P,i,r,g,b)
  176.         END
  177. END TestColorSet;
  178. PROCEDURE Store*;
  179.     VAR S,s : Texts.Scanner;  F : Files.File; len : LONGINT; P : Pictures.Picture; back : ARRAY 32 OF CHAR;
  180.         i,res : INTEGER;
  181.     PROCEDURE PictureViewer(V : Viewers.Viewer) ;
  182.     BEGIN
  183.         Texts.OpenScanner(S,V.dsc(TextFrames.Frame).text,0);
  184.         IF V.dsc.next IS PictureFrames.Frame THEN
  185.             P := V.dsc.next(PictureFrames.Frame).pict
  186.         END
  187.     END PictureViewer;
  188. BEGIN
  189.     P := NIL;
  190.     IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN
  191.         PictureViewer(Oberon.Par.vwr)
  192.     ELSE
  193.         PictureViewer(Oberon.MarkedViewer());
  194.         OpenScanner(s); Texts.Scan(s);
  195.         IF (s.class # Texts.Char) OR (s.c # "*") THEN OpenScanner(S) END
  196.     END;
  197.     Texts.Scan(S);
  198.     IF (S.class = Texts.Name) & (P # NIL) THEN
  199.         Texts.WriteString(W,"Paint.Store "); Texts.WriteString(W,S.s); Texts.WriteLn(W); Texts.Append(Oberon.Log,W.buf);
  200.         i := 0; back[i] := S.s[i];
  201.         WHILE (i < 28) & (S.s[i] # ".") & (S.s[i]# 0X) DO INC(i); back[i] := S.s[i] END;
  202.         back[i+1] := "B"; back[i +2] := "a"; back[i+3] := "k"; back[i+4] := 0X;
  203.         Files.Rename(S.s,back,res);
  204.         F := Files.New(S.s);
  205.         TestColorSet(P);
  206.         Pictures.Store(P,F,0,len);
  207.         Files.Register(F); Files.Close(F)
  208. END Store;
  209. PROCEDURE SetGrid*;
  210.     VAR S : Texts.Scanner;
  211. BEGIN
  212.     OpenScanner(S); Texts.Scan(S);
  213.     IF S.class = Texts.Int THEN
  214.         PictureFrames.grid := SHORT(ABS(S.i))
  215. END SetGrid;
  216. PROCEDURE Smooth*;
  217.     VAR S : Texts.Scanner;
  218. BEGIN
  219.     OpenScanner(S); Texts.Scan(S);
  220.     IF S.class = Texts.Name THEN
  221.         PictureFrames.smooth := S.s = "on"
  222. END Smooth;
  223. PROCEDURE SetWidth*;
  224.     VAR S : Texts.Scanner;
  225. BEGIN
  226.     OpenScanner(S); Texts.Scan(S);
  227.     IF S.class = Texts.Int THEN
  228.         PictureFrames.lineWidth :=  SHORT(ABS(S.i))
  229. END SetWidth;
  230. PROCEDURE SetColor*;
  231.     VAR S : Texts.Scanner;
  232. BEGIN
  233.     OpenScanner(S); Texts.Scan(S);
  234.     IF S.class = Texts.Int THEN
  235.         PictureFrames.color :=  SHORT(ABS(S.i))
  236. END SetColor;
  237. PROCEDURE Print*;
  238.     VAR err, name : ARRAY 32 OF CHAR;  s : Texts.Scanner; p : Pictures.Picture;  V : Viewers.Viewer;
  239. BEGIN
  240.     Texts.WriteString(W,"Paint.Print is not available. Store Pict as IFF and use Amiga-OS to print. Printing of PictElems does work.");
  241.     Texts.WriteLn(W);Texts.Append(Oberon.Log,W.buf)
  242.     p := NIL;
  243.     OpenScanner(s); Texts.Scan(s);
  244.     COPY(s.s,name);
  245.     IF name[0] # 0X THEN
  246.         Texts.Scan(s);
  247.         IF s.class = Texts.Name THEN NEW(p); Pictures.Open(p,s.s) END;
  248.         IF (s.class = Texts.Char) & (s.c = "*") THEN V := Oberon.MarkedViewer();
  249.             IF V.dsc.next IS PictureFrames.Frame THEN
  250.                 p :=  V.dsc.next(PictureFrames.Frame).pict; Texts.OpenScanner(s,V.dsc(TextFrames.Frame).text,0); Texts.Scan(s)
  251.             END
  252.         END;
  253.         IF p # NIL THEN
  254.             Texts.WriteString(W,"Paint.Print "); Texts.WriteString(W,name); Texts.Write(W," ");Texts.WriteString(W,s.s);
  255.             Texts.Append(Oberon.Log,W.buf);
  256.             Printer.Open(name,Oberon.User, Oberon.Password);
  257.             IF Printer.res = 0 THEN
  258.                 Printer.Picture(0,100,p.width,p.height, Display.replace, Pictures.Address(p));
  259.                 IF Printer.res = 0 THEN Printer.Page(1);
  260.                     IF Printer.res = 0 THEN
  261.                         Printer.Close
  262.                     END
  263.                 END
  264.             END;
  265.             err := "";
  266.             IF Printer.res # 0 THEN
  267.                 IF Printer.res = 1 THEN err := " no connection"
  268.                 ELSIF Printer.res = 2 THEN err := " no link"
  269.                 ELSIF Printer.res = 3 THEN err := " printer not ready"
  270.                 ELSIF Printer.res = 4 THEN err := " no permission" END
  271.             END;
  272.             Texts.WriteString(W,err); Texts.WriteLn(W);Texts.Append(Oberon.Log,W.buf)
  273.         END
  274. END Print;
  275. BEGIN
  276.     Texts.OpenWriter(W)
  277. END Paint.
  278.